home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
games_d
/
hunchy.zip
/
HPLAY.INC
< prev
next >
Wrap
Text File
|
1980-01-01
|
3KB
|
140 lines
procedure InitPlay;
begin
Octave:=2;
AllLength:=1/4;
Tempo:=120;
Music:=7/8;
Step:=True;
end;
procedure Play(ComLin:Str255);
type
ChrSet=set of char;
const
Comms:ChrSet=['L','M','N','<','>','O','P','S','T'];
Notes:ChrSet=['A'..'G'];
Appix:ChrSet=['#','+','-','.'];
Numbers:ChrSet=['0'..'9'];
var
Ctr:integer;
ComLinPos:byte;
Command:Str255;
procedure NoSpaces(var Lin:Str255);
var Tmp:Str255;
Ctr:byte;
begin
Tmp:='';
for Ctr:=1 to Length(Lin) do
if not(Lin[Ctr] in [' ',',']) then Tmp:=Tmp + UpCase(Lin[Ctr]);
Lin:=Tmp;
end;
function GetSymbol(Lin:Str255; LinPos:byte; TrmSet:ChrSet):Str255;
var ComLen:byte;
begin
GetSymbol:='';
if Lin [LinPos] in TrmSet then begin
ComLen:=1;
while not(Lin [LinPos+ComLen] in TrmSet) and
not(LinPos+ComLen>255) do Inc(ComLen);
GetSymbol:=Copy(Lin,LinPos,ComLen);
end;
end;
function GetNumber(Lin:Str255; var LinPos:byte):integer;
var ComLen:byte;
Code,Tmp:integer;
begin
Tmp:=0;
ComLen:=1;
while Lin [LinPos+ComLen] in Numbers do
Inc(ComLen);
Val(Copy(Lin,LinPos,ComLen),Tmp,Code);
Inc(LinPos,ComLen-1);
GetNumber:=Tmp;
end;
procedure ProcessCommand(Com:Str255);
var ThisLen:real;
p:byte;
begin
p:=2;
case Com[1] of
'L':AllLength:=1/GetNumber(Com,p);
'<':if Octave > 0 then Dec(Octave);
'>':if Octave < 9 then Inc(Octave);
'O':Octave:=GetNumber(Com,p);
'P':begin
NoSound;
ThisLen:=AllLength;
if Length(Com)>1 then ThisLen:=1/GetNumber(Com,p);
Delay(Round(ThisLen*(256-Tempo)*15));
end;
'T':Tempo:=GetNumber(Com,p);
'M':case Com[2] of
'7':Music:=7/8;
'1':Music:=1;
'3':Music:=3/4;
end;
'S':Step:=Boolean(Ord(Com[2])-48);
end;
end;
procedure PlayNote(Com:Str255);
var Ctr,ThisOct:byte;
Frequency,ThisLen:real;
Note,Dummy:integer;
begin
ThisOct:=Octave;
ThisLen:=AllLength;
Note:=Pos(Com[1], 'C D EF G A B');
Ctr:=2;
while Ctr <= Length(Com) do begin
case Com[Ctr] of
'#','+':Inc(Note);
'-':Dec(Note);
'.':ThisLen:=ThisLen * 3/2;
'0'..'9':ThisLen:=1/GetNumber(Com,Ctr);
end;
Inc(Ctr);
end;
if Note<1 then begin
Dec(ThisOct);
Note:=12;
end else
if Note>12 then begin
Inc(ThisOct);
Note:=1;
end;
Frequency:=32.625;
for Ctr:=1 to ThisOct do
Frequency:=Frequency * 2;
for Ctr:=1 to Note - 1 do
Frequency:=Frequency * 1.059463094;
if ThisLen <> 0.0 then
begin
if Step then NoSound;
Sound(Round(Frequency));
Delay(Round(ThisLen*(256-Tempo)*15*Music)*Ord(not ScrlLk));
end
else Sound(Round(Frequency));
end;
begin
NoSound;
NoSpaces(ComLin);
ComLinPos:=1; Command:='';
repeat
GetShiftStats;
Command:=GetSymbol(ComLin,ComLinPos,Comms+Notes);
if KeyPressed and TitleMusic then TuneStopped:=True;
if(Command <> '') then begin
if Command [1] in Comms then ProcessCommand(Command)
else if Command [1] in Notes then PlayNote(Command);
end;
Inc(ComLinPos, Length(Command));
until(ComLinPos > Length(ComLin)) or TuneStopped;
NoSound;
end;